home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 25 / Cream of the Crop 25.iso / os2 / kzr0597.zip / KZR.CMD < prev    next >
OS/2 REXX Batch file  |  1997-03-13  |  21KB  |  620 lines
  1. /* REXX-Programm kzr.CMD */
  2.  
  3.    "@ echo off"
  4.    Call RxFuncAdd 'SysLoadFuncs', RexxUtil, 'SysLoadFuncs'
  5.    Call SysLoadFuncs
  6.  
  7.    /* Wird bei der Ausführung einer REXX-Anweisung ein Syntaxfehler */
  8.    /* festgestellt, so wird zur Prozedur "Fehlermeldung" verzweigt. */
  9.    signal on syntax name Fehlermeldung
  10.  
  11.    /* Die Datei "Ergebnis.DAT" wird in dem Verzeichnis abgelegt, */
  12.    /* in dem auch die Datei "kzr.CMD" abgelegt ist.              */
  13.    Pfd=SysSearchPath("PATH", "kzr.cmd")
  14.    lp=LastPos("\", Pfd)
  15.    Pfd=DelStr(Pfd, 1+lp)
  16.    buferg=Pfd||"Ergebnis.DAT"
  17.    bufND =Pfd||"NDZahl.DAT"
  18.    bufNDA=Pfd||"NDAZahl.DAT"
  19.    bufMsg=Pfd||"Meldung.DAT"
  20.  
  21.    z = LineIn(buferg, 1)
  22.    zv=z
  23.    if length(zv)=0 then zv="Keines"
  24.  
  25.    /* Der Befehl "Call charout(buferg)" ist erforderlich, weil sonst */
  26.    /* die Datei  Ergebnis.DAT, die über den Pfad Pfd erreichbar ist, */
  27.    /* nicht gelöscht werden kann.                                    */
  28.    Call charout(buferg);   Call SysFileDelete buferg
  29.  
  30.    parse arg str;   str=strip(str)
  31.  
  32.    if (length(str)= 0) then do; "view.exe" Pfd||"KZR.INF"; EXIT;end
  33.  
  34.    /* Prüfung, ob das  e r s t e  Komma nach "kzr" eingegeben wurde. */
  35.    ww=word(str, 1)
  36.    l1=length(ww)
  37.    lk=Pos(",", ww)
  38.    p1=wordpos(" , ", str)
  39.  
  40.    if l1 <> lk then
  41.    do
  42.      if p1 = 0 then
  43.      do
  44.        Call charout(bufND);   Call SysFileDelete bufND
  45.        Call charout(bufMsg);  Call SysFileDelete bufMsg
  46.        Call kommav
  47.      end
  48.    end
  49.  
  50.    /* Zerlegen des Kommandozeilen-Strings nach eine Schablone.  */
  51.    /* Das "UPPER" ist wichtig, damit verschiedene Schreibweisen */
  52.    /* von "externen" Operatoren, wie z.B. divganz, DivGanz oder */
  53.    /* dIVgANZ auch richtig erkannt werden.                      */
  54.    parse UPPER value str with ND ',' st ';' v1 ',' v2
  55.    /* v1 ist die Zuweisung für die Variable 1                       */
  56.    /* und v2 die Zuweisung für die Variable 2.                      */
  57.    /* v1, v2 oder auch v1 unv v2 können nach der Formulierung der   */
  58.    /* Rechenaufgabe auf der Kommandozeile, jeweils durch ein Komma  */
  59.    /* getrennt auf der Kommandozeile eingegeben werden.             */
  60.    /* v1 und v2 müssen aber nicht eingegeben werden, wenn in der    */
  61.    /* eigentlichen "Rechenaufgabe" keine Variablen vorhanden sind.  */
  62.  
  63.    /* Prüfung, ob  ND  eine gültige REXX-Zahl ist */
  64.    if Datatype(ND, N) <> 1 & length(ND) > 0 then
  65.    do
  66.      Call charout(bufND);   Call SysFileDelete bufND
  67.      Call charout(bufMsg);  Call SysFileDelete bufMsg
  68.      Call FalschZahl ND
  69.    end
  70.  
  71.    /* Prüfung, ob  ND  größer als  1  ist */
  72.    if length(ND) > 0 & ND < 2 then
  73.    do
  74.      Call charout(bufND);   Call SysFileDelete bufND
  75.      Call charout(bufMsg);  Call SysFileDelete bufMsg
  76.      Call FalschArg
  77.    end
  78.  
  79.    if length(ND) = 0 then ND = 20
  80.    Numeric digits ND
  81.    /* Die Variable ND wird an  bufND übergeben */
  82.    ret=LineOut(bufND, ND)
  83.  
  84.    /* Es wird überprüft, ob die Variablen-Zuweisung auf der */
  85.    /* Kommandozeile korrekt ist.                            */
  86.    if length(strip(v1)) > 0 & Pos("=", v1) = 0 then Call NoVar
  87.    if length(strip(v2)) > 0 & Pos("=", v2) = 0 then Call NoVar
  88.  
  89.    if Pos("'", st) > 0 | Pos('"', st) > 0 | Pos("@", st) > 0 | ,
  90.       Pos("?", st) > 0 | Pos('\', st) > 0 | Pos('#', st) > 0 | ,
  91.       Pos('', st) > 0 | Pos('$', st) > 0 then
  92.    do
  93.      Call charout(bufND);   Call SysFileDelete bufND
  94.      Call charout(bufMsg);  Call SysFileDelete bufMsg
  95.      Call QuoteFilter
  96.    end
  97.  
  98.    st1=st
  99.    if Pos(":",   st1)     > 0 then st2=Filter2(st1); else st2=st1
  100.    if Pos("DIVGANZ", st2) > 0 then st3=Filter3(st2); else st3=st2
  101.    if Pos("DIVREST", st3) > 0 then st4=Filter4(st3); else st4=st3
  102.    st=st4
  103.  
  104.    select
  105.      when  Pos(")0", st) > 0  then Signal twt
  106.      when  Pos(")1", st) > 0  then Signal twt
  107.      when  Pos(")2", st) > 0  then Signal twt
  108.      when  Pos(")3", st) > 0  then Signal twt
  109.      when  Pos(")4", st) > 0  then Signal twt
  110.      when  Pos(")5", st) > 0  then Signal twt
  111.      when  Pos(")6", st) > 0  then Signal twt
  112.      when  Pos(")7", st) > 0  then Signal twt
  113.      when  Pos(")8", st) > 0  then Signal twt
  114.      when  Pos(")9", st) > 0  then Signal twt
  115.      when  Pos("),", st) > 0  then Signal twt
  116.      when  Pos(").", st) > 0  then Signal twt
  117.      otherwise Signal twtw
  118.    end
  119. twt:
  120.      Call charout(bufND);   Call SysFileDelete bufND
  121.      Call charout(bufMsg);  Call SysFileDelete bufMsg
  122.      Call Unsinn
  123. twtw:
  124.    stst=strip(st)
  125.    v1  =strip(v1)
  126.    v2  =strip(v2)
  127.  
  128. /*   Wichtig, damit das Ergebnis in der Variablen z verfügbar ist, und */
  129. /*   daß zuerst die Variablen  v1, v2 oder auch v1 und v2 ügbar ist.    */
  130.    if length(v1) > 0 & length(v2) > 0 then
  131.    do
  132.    /* Hier ist zweimal ein Semikolon erforderlich, */
  133.    /* da Trennung von drei REXX-Anweisungen        */
  134.      st=v1||";"||v2||";   "||"z = "||stst
  135.      Signal NV
  136.    end
  137.  
  138.    if length(v1) > 0 & length(v2) = 0 then
  139.    do
  140.    /* Hier ist einmal ein Semikolon erforderlich,  */
  141.    /* da Trennung von zwei REXX-Anweisungen        */
  142.      st=v1||";   "||"z = "||stst
  143.      Signal NV
  144.    end
  145.  
  146.    if length(v2) > 0 & length(v1) = 0 then
  147.    do
  148.    /* Hier ist einmal ein Semikolon erforderlich,  */
  149.    /* da Trennung von zwei REXX-Anweisungen        */
  150.      st=v2||";   "||"z = "||stst
  151.      Signal NV
  152.    end
  153.  
  154.    st ="z = "||stst
  155. NV:
  156.    stA="z = "||stst
  157.  
  158.    /* Für die Anzeige der aktuellen Berechnung sollen von  kzr.CMD  */
  159.    /* in große Buchstaben umgewandelte kleinen Buchstaben wieder    */
  160.    /* in kleine Buchstaben umgewandelt wrden.                       */
  161.    kl="abcdefghijklmnopqrstuvwxyzäöü";  gr="ABCDEFGHIJKLMNOPQRSTUVWXYZÄÖÜ"
  162.    stA=translate(stA, kl, gr)
  163.    v1 =translate(v1,  kl, gr)
  164.    v2 =translate(v2,  kl, gr)
  165.    say
  166.    Numeric Digits ND+4  /* Intern wird mit ND+4 Dezimalstellen gerechnet. */
  167.    /* Dies ist der wichtigste Befehl ! */
  168.    /**/         interpret st         /**/
  169.    /* Dies ist der wichtigste Befehl ! */
  170.  
  171.  /* Von NDA_MIN wird der niedrigste Wert NDA für die Rechengenauigkeit    */
  172.  /* der verwendeten Funktionen ermittelt und dieser "Kernfunktion"kzr.CMD */
  173.  /* für die Ergebnisanzeige übergeben.                                    */
  174.    ND=MinNDA()
  175.    Numeric Digits ND
  176.  
  177.    /* Nur wenn das Ergebnis eine gültige REXX-Zahl ist, Ergebnis formen */
  178.    if DataType(z, N) = 1 then
  179.    do
  180.      Numeric Digits ND
  181.      zz=Format(z, , , , )
  182.      st10=ErgFormat(zz)
  183.    end
  184.    else st10=z
  185.  
  186.    /* Ausgabe, wenn ein Ergebnis berechnet werden konnte */
  187.    Call Color "White"
  188.    Call Charout,"Ergebnis der vorangegangenen Berechnung:"; say; say
  189.    Call CsrAttrib "High";  Call Color "Green"
  190.    Call Charout,"   "zv; say; say; say
  191.    Call CsrAttrib "Normal";  Call Color "White"
  192.    Call Charout,"Aufgabe der aktuellen Berechnung:"
  193.    say; say
  194.    Call CsrAttrib "High";   Call Color "White"
  195.  
  196.    if length(v1) > 0 then
  197.    do
  198.      parse value v1 with w1 '=' w2
  199.      v1=strip(w1)||" = "||strip(w2)
  200.      Call Charout,"  "v1; say
  201.    end
  202.  
  203.    if length(v2) > 0 then
  204.    do
  205.      parse value v2 with w1 '=' w2
  206.      v2=strip(w1)||" = "||strip(w2)
  207.      Call Charout,"  "v2; say
  208.    end
  209.  
  210.    Call Charout,"  "stA; say; say; say
  211.    Call CsrAttrib "Normal"; Call Color "White"
  212.    Call Charout,"Ergebnis  ";
  213.    Call CsrAttrib "High";
  214.    Call Charout,"z"
  215.    Call CsrAttrib "Normal";
  216.    Call Charout,"  der aktuellen Berechnung mit "
  217.    Call CsrAttrib "High";
  218.    Call Charout,ND
  219.    Call CsrAttrib "Normal"
  220.    Call Charout," Dezimalstellen:"
  221.    say; say
  222.    Call CsrAttrib "High";  Call Color "Cyan"
  223.    Call Charout,"  "st10; say
  224.  
  225.    /* Nur bei verschiedenen Ausgabeformaten Ausgabe von zwei Anzeigen. */
  226.    if Compare(st10,  Format(st10, , , ,0)) <> 0 then
  227.    do
  228.       Call Charout,"  "Format(st10, , , ,0)
  229.    say
  230.    end
  231.    Call CsrAttrib "Normal";
  232.    ret=LineOut(buferg, st10)
  233.  
  234. PgmEnd:
  235.    Call CsrAttrib "Normal"
  236.    Call charout(bufND);   Call SysFileDelete bufND
  237.    Call charout(bufNDA);  Call SysFileDelete bufNDA
  238.    Call charout(bufMsg);  Call SysFileDelete bufMsg
  239.    /* Das REXX-Programm MinNDA.CMD löscht temporäre Dateien,          */
  240.    /* die von "externen" mathematischen Funktionen hizugefügt wurden. */
  241.    Dummy=MinNDA()
  242.  
  243. ende:
  244. EXIT
  245.  
  246. /******************************* Prozeduren *********************************/
  247.  
  248. Filter2:
  249.   Procedure
  250.   parse arg str
  251.   i=1; st2.i=str
  252.   Anf2:
  253.   j=i+1
  254.   l2.i=Pos(":", st2.i)
  255.   if l2.i=0 then Signal w2e
  256.   st2.j=Overlay("/", st2.i, l2.i)
  257.   st2=st2.j
  258.   i=i+1
  259.   Signal Anf2
  260.   w2e:
  261.   Return(st2)
  262.  
  263. Filter3:
  264.   Procedure
  265.   parse arg str
  266.   i=1; st3.i=str
  267.   Anf3:
  268.   j=i+1
  269.   l3.i=Pos("DIVGANZ", st3.i); if l3.i > 0 then Signal w31
  270.   w31:
  271.   if l3.i=0 then Signal w3e
  272.   sub3.i=SubStr(st3.i, l3.i, 7)
  273.   st3.i =DelStr(st3.i, l3.i, 7)
  274.   if  sub3.i=="DIVGANZ" then neu3.i="%"
  275.   st3.j=Insert(neu3.i, st3.i, l3.i-1  ); st3=st3.j
  276.   i=i+1
  277.   signal Anf3
  278.   w3e:
  279.   Return(st3)
  280.  
  281. Filter4:
  282.   Procedure
  283.   parse arg str
  284.   i=1; st4.i=str
  285.   Anf4:
  286.   j=i+1
  287.   l4.i=Pos("DIVREST", st4.i); if l4.i > 0 then Signal w41
  288.   w41:
  289.   if l4.i=0 then Signal w4e
  290.   sub4.i=SubStr(st4.i, l4.i, 7)
  291.   st4.i =DelStr(st4.i, l4.i, 7)
  292.   if  sub4.i=="DIVREST" then  neu4.i="//"
  293.   st4.j=Insert(neu4.i, st4.i, l4.i-1  ); st4=st4.j
  294.   i=i+1
  295.   signal Anf4
  296.   w4e:
  297.   Return(st4)
  298.  
  299. /* Diese Funktion entfernt den Dezimalpunkt und die darauf folgenden      */
  300. /* Ziffern  "0"  , wenn nach diesem Dezimalpunkt nur noch Nullen folgen.  */
  301. ErgFormat:
  302.   Procedure
  303.   arg u
  304.   /* Nur wenn das Ergebnis einen Dezimalpunkt enthält */
  305.   /* und in der Exponential-Schreibweise vorliegt.    */
  306.   if Pos(".", u)>0 & Pos("E", u)=0 then
  307.   do
  308.   /* Ziffern-Reihe aus der Ziffer  "0"  nach dem Dezimalpunkt entfernen */
  309.     do forever
  310.       lu=length(u)
  311.       if Pos("0", u, lu) > 0 then u=DelStr(u, lu); else leave
  312.     end
  313.     /* Den Dezimalpunkt entfernen */
  314.     lu=length(u)
  315.     if Pos(".", u) = lu then u=DelStr(u, lu)
  316.    end
  317.    Return(u)
  318.  
  319. NoVar:
  320.   say
  321.   Call CsrAttrib "High";   Call Color "Red"
  322.   Call Charout,"Kein Ergebnis !"; say; say
  323.   Call Color "White"
  324.   Call Charout,"Sie haben einen algebraisch unsinnigen Ausdruck eingeben"; say
  325.   Call Charout,"oder einer Variablen keinen Wert zugewiesen. (NoVar)";say
  326.   Call CsrAttrib "Normal"
  327.   say
  328.   Beep(444, 200); Beep(628,300)
  329.   Signal PgmEnd
  330.  
  331. kommav:
  332.   say
  333.   Call CsrAttrib "High";   Call Color "white"
  334.   Call Charout,"In dem Kommandozeilen-String muß nach dem Teilstring  "
  335.   Call Color "cyan"
  336.   Call Charout,"kzr"; say
  337.   Call Color "white"
  338.   Call Charout,"mindestens  "
  339.   Call Color "green"
  340.   Call Charout,"1"
  341.   Call Color "white"
  342.   Call Charout,"  Leerzeichen enthalten sein."; say
  343.   Call Charout,"Darauf folgend, bevor die eigentliche ""Rechenaufgabe"" eingegeben wird,"; say
  344.   Call Charout,"entweder";say
  345.   Call Charout,"         ein "
  346.   Call Color "cyan"
  347.   Call Charout,"einzelnes Komma"
  348.   Call Color "white"
  349.   Call Charout," mit mindestens  "
  350.   Call Color "green"
  351.   Call Charout,"1"
  352.   Call Color "white"
  353.   Call Charout,"  Leerzeichen dahinter,"; say
  354.   Call Charout,"oder";say
  355.   Call Charout,"         eine "
  356.   Call Color "cyan"
  357.   Call Charout,"ganze Zahl > 1"
  358.   Call Color "white"
  359.   Call Charout,", gefolgt von"; say
  360.   Call Charout,"         einem "
  361.   Call Color "cyan"
  362.   Call Charout,"einzelnen Komma"
  363.   Call Color "white"
  364.   Call Charout," mit mindestens  "
  365.   Call Color "green"
  366.   Call Charout,"1"
  367.   Call Color "white"
  368.   Call Charout,"  Leerzeichen dahinter."; say; say
  369.   Call Charout,"Näheres ist in der "
  370.   Call Color "Green"
  371.   Call Charout,"kzr.INF"
  372.   Call Color "white"
  373.   Call Charout," zu finden."
  374.   say
  375.   Beep(444, 200); Beep(628,300)
  376.   Signal PgmEnd
  377.  
  378. FalschZahl:
  379.   say
  380.   arg ND
  381.   Call CsrAttrib "High";   Call Color "Red"
  382.   Call Charout,"Kein Ergebnis !"; say; say
  383.   Call Color "White"
  384.   Call Charout,"Anstelle einer ganzen Zahl, die größer als  1  sein muß,"; say
  385.   Call Charout,"haben Sie den String  "
  386.   Call Color "cyan"
  387.   Call Charout,strip(ND)
  388.   Call Color "White"
  389.   Call Charout,"  eingegeben."
  390.   Call CsrAttrib "Normal"
  391.   say
  392.   Beep(444, 200); Beep(628,300)
  393.   Signal PgmEnd
  394.  
  395.  
  396. FalschArg:
  397.   say
  398.   Call CsrAttrib "High";   Call Color "yellow"
  399.   Call Charout,"In dem Kommandozeilen-String muß zwischen dem Teilstring  "
  400.   Call Color "cyan"
  401.   Call Charout,"kzr"; say
  402.   Call Color "yellow"
  403.   Call Charout,"und dem ersten  "
  404.   Call Color "cyan"
  405.   Call Charout,"Komma"
  406.   Call Color "yellow"
  407.   Call Charout,"  entweder"; say; say
  408.   Call Charout,"eine  "
  409.   Call Color "Green"
  410.   Call Charout,"ganze Zahl > 1"
  411.   Call Color "Yellow"
  412.   Call Charout,"  oder"; say
  413.   Call Charout,"mindestens  "
  414.   Call Color "Green"
  415.   Call Charout,"1"
  416.   Call Color "Yellow"
  417.   Call Charout,"  Leerzeichen eingegeben werden."
  418.   Call CsrAttrib "Normal"
  419.   say
  420.   Beep(444, 200); Beep(628,300)
  421.   Signal PgmEnd
  422.  
  423. Fehlermeldung:
  424.   ret=SysCurState("OFF")
  425.   sf=ErrorText(RC)
  426.  
  427.   Call CsrLeft 10
  428.   Call Charout,"                                                                              "; say
  429.   Call Charout,"                                                                              "; say
  430.   Call Charout,"                                                                              "; say
  431.   Call Charout,"                                                                              "; say
  432.   Call Charout,"                                                                              "; say
  433.   Call Charout,"                                                                              "; say
  434.   Call Charout,"                                                                              "; say
  435.   Call Charout,"                                                                              "; say
  436.   Call Charout,"                                                                              "; say
  437.   Call Charout,"                                                                              "; say
  438.   Call Charout,"                                                                              "; say
  439.   Call Charout,"                                                                              "; say
  440.   Call Charout,"                                                                              "; say
  441.   Call CsrUp 12
  442.  
  443.   if  Pos("Invalid ex", sf) > 0 then
  444.   do
  445.     sfstr="Sie haben einen algebraisch unsinnigen Ausdruck eingeben,",
  446.           "                     ",
  447.           "einer Variablen keinen Wert zugewiesen",
  448.           "                                        ",
  449.           "oder gar keine mathematische Funktion aufgerufen."
  450.     Signal raus
  451.   end
  452.  
  453.   if  Pos("Arithmetic", sf) > 0 then
  454.   do
  455.     sfstr="Haben Sie etwa versucht, durch  0  zu dividieren ?   ·····   Pfui !"
  456.     Signal raus
  457.   end
  458.  
  459.   if  Pos('Unexpected "," or ")"', sf) > 0 then
  460.   do
  461.     sfstr="Sie haben zuviele rechte Klammern oder ein unzulässiges Komma eingegeben."
  462.     Signal raus
  463.   end
  464.  
  465.   if  Pos("Invalid ch", sf) > 0 then
  466.   do
  467.     sfstr="Sie haben ein in algebraischen Ausdrücken unzulässiges Symbol eingegeben."
  468.     Signal raus
  469.   end
  470.  
  471.   if  Pos("Unmatched", sf) > 0 & Pos("in expression", sf, 15) > 0 then
  472.   do
  473.     sfstr="Sie haben zu viele linke Klammern eingegeben."
  474.     Signal raus
  475.   end
  476.  
  477.   if  Pos("Bad arithmetic conversion", sf) > 0 then
  478.   do
  479.     sfstr="     Sie haben einen algebraisch unsinnigen Ausdruck eingeben",
  480.           "                 ",
  481.           "     oder einer Variablen keinen Wert zugewiesen.",
  482.           "                             ",
  483.           "     Möglicherweise aber wollten Sie in der aktuellen Rechenaufgabe",
  484.           "           ",
  485.           "     mit der Spezialvariablen  z  das Ergebnis der (gescheiterten)",
  486.           "            ",
  487.           "     vorangegangenen Rechenaufgabe verwenden,",
  488.           "                                 ",
  489.           "     der natürlich noch kein Wert zugewiesen war."
  490.     Signal raus
  491.   end
  492.  
  493.   if  Pos("Routine not", sf) > 0 then
  494.   do
  495.     sfstr="Die Funktion in diesem Ausdruck kann nicht aufgerufen werden."
  496.     Signal raus
  497.   end
  498.  
  499.   if  Pos("Invalid whole number", sf) > 0 then
  500.   do
  501.     sfstr="     Entweder werden für die interne Rechengenauigkeit",
  502.           "                        ",
  503.           "     zu wenig Dezimalstellen verwendet,",
  504.           "                                       ",
  505.           "     oder Sie haben als Exponenten keine ganzen Zahlen eingegeben."
  506.     Signal raus
  507.   end
  508.  
  509.   if  Pos("Unknown command", sf) > 0 then
  510.   do
  511.     sfstr="Eingabe oder Ergebnis der Berechnung ist keine gültige REXX-Zahl."
  512.     Signal raus
  513.   end
  514.  
  515.   if  Pos("Name starts with number or", sf) > 0 then
  516.   do
  517.     sfstr="Sie haben einer Variablen keinen Wert zugewiesen. (Name starts with number)"
  518.     Signal raus
  519.   end
  520.  
  521.   /* Gibt Fehlermeldungen eines Unterprogramms zurück, */
  522.   /* die in  bufMsg  gespeichert sind.                 */
  523.   if  Pos("Function did not", sf) > 0 then
  524.   do
  525.     sfstr=LineIn(bufMsg, 1)
  526.     /* Hier besonders wichtig ! */
  527.     Call charout(bufMsg);  Call SysFileDelete bufMsg
  528.     Signal raus
  529.   end
  530.  
  531.   raus:
  532.   Call CsrAttrib "High"; Call Color "Red"
  533.   Call Charout,"Kein Ergebnis !"; say; say
  534.   Call Color "White"
  535.   Call Charout,sfstr; say
  536.   Call charout(bufND);   Call SysFileDelete bufND
  537.   Call charout(bufMsg);  Call SysFileDelete bufMsg
  538.   Beep(444, 200); Beep(628,300)
  539.   Signal PgmEnd
  540.  
  541. Unsinn:
  542.   say;
  543.   Call CsrAttrib "High";   Call Color "red"
  544.   Call charout(bufND);   Call SysFileDelete bufND
  545.   Call charout(bufMsg);  Call SysFileDelete bufMsg
  546.   Call Charout,"Kein Ergebnis !"; say; say
  547.   Call Color "White"
  548.   Call Charout,"Sie haben einen algebraisch unsinnigen Ausdruck eingeben."
  549.   say
  550.   Beep(444, 200); Beep(628,300)
  551.   Signal PgmEnd
  552.  
  553. QuoteFilter:
  554.   say
  555.   Call CsrAttrib "High";   Call Color "red"
  556.   Call Charout,"Kein Ergebnis !"; say; say
  557.   Call Color "White"
  558.   Call Charout,"Die Symbole "
  559.   Call Color "cyan"; Call Charout,""; Call Color "White"; Call Charout,", "
  560.   Call Color "cyan"; Call Charout,"$"; Call Color "White"; Call Charout,", "
  561.   Call Color "cyan"; Call Charout,"="; Call Color "White"; Call Charout,", "
  562.   Call Color "cyan"; Call Charout,"?"; Call Color "White"; Call Charout,", "
  563.   Call Color "cyan"; Call Charout,"\"; Call Color "White"; Call Charout,", "
  564.   Call Color "cyan"; Call Charout,"@"; Call Color "White"; Call Charout,", "
  565.   Call Color "cyan"; Call Charout,"#"; Call Color "White"; Call Charout,", "
  566.   Call Color "cyan"; Call Charout,"'"; Call Color "White"; Call Charout," und "
  567.   Call Color "cyan"; Call Charout,'"'; say
  568.   Call Color "White"
  569.   Call Charout,"dürfen auf der Kommandozeile dieses Programms nicht verwendet werden,"; say
  570.   Call Charout,"weil sie keine der in der arithmetischen Syntax erlaubten Operatoren sind."; say; say
  571.   Call Color "Red"
  572.   Call Charout,"Warnung für weitere Eingaben !"; say; say
  573.   Call Color "White"
  574.   Call Charout,"Die Symbole  "
  575.   Call Color "cyan"; Call Charout,"%"; Call Color "White"; Call Charout,", "
  576.   Call Color "cyan"; Call Charout,"&"; Call Color "White"; Call Charout,", "
  577.   Call Color "cyan"; Call Charout,"<"; Call Color "White"; Call Charout,", "
  578.   Call Color "cyan"; Call Charout,">"; Call Color "White"; Call Charout," und "
  579.   Call Color "cyan"; Call Charout,"|"; Call Color "White"
  580.   Call Charout,"  sowie die Strings  "
  581.   Call Color "cyan"; Call Charout,"<<"; Call Color "White"; Call Charout,", "
  582.   Call Color "cyan"; Call Charout,">>"; Call Color "White";  Call Charout," und "
  583.   Call Color "cyan"; Call Charout,"//"; say
  584.   Call Color "White"
  585.   Call Charout,"dürfen auf der OS/2-Kommandozeile nur in bestimmten Fällen verwendet werden;"; say
  586.   Call Charout,"nur zeigt  "
  587.   Call Color "cyan"; Call Charout,"kzr.CMD"; Call Color "White"
  588.   Call Charout,"  bei Verletzung der einschlägigen Regeln"; say
  589.   Call Charout,"leider keine diesbezüglichen Meldung an."
  590.   say
  591.   Beep(444, 200); Beep(628,300)
  592.   Signal PgmEnd
  593.  
  594. /***************************** ANSI-Prozeduren ******************************/
  595.  
  596. CsrUp: Procedure  /* CsrUp(Rows) */
  597. Arg u
  598. Rc = Charout(,D2C(27)"["u"A")
  599. return ""
  600.  
  601. CsrLeft: procedure
  602. arg l
  603. Rc = Charout(,D2C(27)"["l"D")
  604. Return ""
  605.  
  606. Color: Procedure
  607. arg F,B
  608. Colors = "BLACK RED GREEN YELLOW BLUE MAGENTA CYAN WHITE"
  609. return CHAROUT(,D2C(27)"["WORDPOS(F,COLORS)+29";"WORDPOS(B,COLORS)+39";m")
  610.  
  611. CsrAttrib: Procedure
  612. Arg A
  613. attr = "NORMAL HIGH LOW ITALIC UNDERLINE BLINK RAPID REVERSE"
  614. return CHAROUT(,D2C(27)"["WORDPOS(A,ATTR) - 1";m")
  615.  
  616. EndAll:
  617. Call Color "White","Black"
  618. Call CsrAttrib "Normal"
  619.  
  620.